home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #2 / Ham Radio 2000 - Volume 2.iso / HAMV2 / MISC / HCAL-27 / TUNECCT.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1997-02-26  |  8.3 KB  |  298 lines
  1. 10  'TUNECCT - Tuned Circuit (L/C network) - 27 MAR 86 rev. 30 SEP 96
  2. 20  IF EX$=""THEN EX$="EXIT"
  3. 30  PROG$="tunecct"
  4. 40  COMMON EX$,PROG$,UH,U
  5. 50  CLS:KEY OFF
  6. 60  COLOR 7,0,1
  7. 70  U$="####.###"
  8. 80  U1$="####,###.###"
  9. 90  U2$="####,###"
  10. 100  UL$=STRING$(80,205)
  11. 110  L$=STRING$(40,205)
  12. 120  X$=STRING$(40,32)
  13. 130  PI=3.14159
  14. 140  DIM AWG(40,2)         'AWG sizes
  15. 150  '.....AWG calculator
  16. 160  K#=(0.46/0.005)^(1/39)  'incremental multiplier
  17. 170  FOR Z=1 TO 40
  18. 180   NZ=Z+3
  19. 190   WIRE=0.46/K#^NZ       'wire diameter in inches
  20. 200   CIRC=(WIRE*10^3)^2   'circular mils
  21. 210   OHM=10574/CIRC       'ohms per 1000 ft.
  22. 220   OHM=OHM/(12*10^3)    'ohms per inch
  23. 230   AWG(Z,1)=WIRE
  24. 240   AWG(Z,2)=OHM
  25. 250  NEXT Z
  26. 260  GOTO 340
  27. 270  '
  28. 280  '.....erase lines
  29. 290  FOR Z=E1 TO E2:LOCATE Z,E3:PRINT STRING$(40,32);
  30. 300  IF E2<24 THEN PRINT ""
  31. 310  NEXT Z
  32. 320  RETURN
  33. 330  '
  34. 340  '.....start
  35. 350  CLS
  36. 360  F=0:W=0:C=0:X=0:PF=0:FQC=0
  37. 370  D=0:R=0:L=0:N=0:T=0:Q=0:U=0:UH=0
  38. 380  COLOR 15,2
  39. 390  PRINT " L/C TUNED CIRCUITS (Inductor/Capacitor)";
  40. 400  PRINT TAB(57);"by George Murphy VE3ERP ";
  41. 410  COLOR 1,0:PRINT STRING$(80,223);
  42. 420  COLOR 7,0
  43. 430  GOSUB 2680
  44. 440  PRINT " Press number in < > to choose standard units of measure:"
  45. 450  PRINT UL$;
  46. 460  PRINT "   < 1 >  Metric"
  47. 470  PRINT "   < 2 >  U.S.A./Imperial"
  48. 480  PRINT UL$;
  49. 490  PRINT "     or Press < 0 > to EXIT....."
  50. 500  Z$=INKEY$
  51. 510  IF Z$="0"THEN CLS:CHAIN EX$
  52. 520  IF Z$="1"THEN UM=25.4:UM$="mm.":GOTO 550
  53. 530  IF Z$="2"THEN UM=1:UM$="in.":GOTO 550
  54. 540  GOTO 500
  55. 550  VIEW PRINT 3 TO 24:CLS:VIEW PRINT:LOCATE 3
  56. 560  PRINT " Press letter in < > to:"
  57. 570  PRINT UL$;
  58. 580  PRINT "  < 1 >  Design a tuned L/C network"
  59. 590  PRINT "  < 2 >  Design a single-layer air-core coil"
  60. 600  PRINT "  < 3 >  Find impedance of an L/C network"
  61. 610  PRINT "  < 4 >  Find insertion loss of a tuned circuit"
  62. 620  PRINT UL$;
  63. 630  Z$=INKEY$
  64. 640  IF Z$="1"OR Z$="2" THEN VIEW PRINT 3 TO 24:CLS:VIEW PRINT
  65. 650  IF Z$="1"THEN 1300
  66. 660  IF Z$="2"THEN 710
  67. 670  IF Z$="3"THEN CLS:CHAIN"dsgnmenu"
  68. 680  IF Z$="4"THEN CLS:CHAIN"inserlos"
  69. 690  GOTO 630
  70. 700  '
  71. 710  '.....INDUCT - 26 MAR 86 rev.15 MAR 95
  72. 720  LOCATE 3
  73. 730  PRINT TAB(7);"SINGLE-LAYER AIR-CORE COIL"
  74. 740  PRINT UL$;
  75. 750  LOCATE CSRLIN-3,40:PRINT "OPEN"
  76. 760  LOCATE CSRLIN,40:PRINT "OPEN"
  77. 770  LOCATE CSRLIN,40:PRINT "LOCATE"
  78. 780  '.....inputs
  79. 790  GOSUB 910:IF R THEN 810
  80. 800  PRINT " ENTER: Coil diameter (";UM$;")";:INPUT D:D=D/UM:R=D/2
  81. 810  GOSUB 910:IF L THEN 830
  82. 820  PRINT " ENTER: Coil length (";UM$;")..";:INPUT L:L=L/UM
  83. 830  GOSUB 910:IF U+N THEN 850
  84. 840  INPUT " ENTER: Inductance (>H) .......";U
  85. 850  GOSUB 910:IF N+U THEN 870
  86. 860  INPUT " ENTER: Number of turns .......";N
  87. 870  GOSUB 910:IF T THEN 890
  88. 880  INPUT " ENTER: Turns per 25.4mm (inch)";T
  89. 890  GOSUB 910:GOTO 790
  90. 900  '
  91. 910  LOCATE 5:PRINT X$
  92. 920  IF U=0 THEN IF R*L*N THEN U=R^2*N^2/(9*R+10*L)
  93. 930  IF N=0 THEN IF R*L*U THEN N=(SQR(U*(9*R+10*L)))/R
  94. 940  IF N=0 THEN IF L*T THEN N=L*T
  95. 950  IF L=0 THEN IF N*T THEN L=N/T
  96. 960  IF T=0 THEN IF N*L THEN T=N/L
  97. 970  IF L=0 THEN IF R*T*U THEN Q=R^2*T^2/U:L=ABS(-10-SQR(100+36*R*Q))/2/Q
  98. 980  IF R*L*N*U THEN 1000 ELSE LOCATE 5:RETURN
  99. 990  '
  100. 1000  LOCATE 5:PRINT X$:LOCATE 5
  101. 1010  PRINT " Coil diameter (";UM$;")......";USING U1$;D*UM
  102. 1020  PRINT " Coil length (";UM$;")........";USING U1$;L*UM
  103. 1030  PRINT " Number of turns .........";USING U1$;N
  104. 1040  PRINT " Turns per 25.4mm (inch)..";USING U1$;T
  105. 1050  SP=1/T
  106. 1060  PRINT " Turn spacing (";UM$;").......";USING U1$;SP*UM
  107. 1070  PRINT " Inductance (>H) .........";USING U1$;U
  108. 1080  PRINT L$
  109. 1090  UCOIL=U      'remember inductance
  110. 1100  GOSUB 2080   'Q option
  111. 1110  GOSUB 2850   'screen dump option
  112. 1120  '
  113. 1130  LOCATE 25,1:PRINT STRING$(80,32);
  114. 1140  E1=11:E2=17:E3=1:GOSUB 280
  115. 1150  LOCATE 17
  116. 1160  PRINT " Press number in ( ) for next step:
  117. 1170  PRINT L$
  118. 1180  PRINT " (1) Design another coil with same uH"
  119. 1190  PRINT " (2) Design an optimum coil with same uH"
  120. 1200  PRINT " (3) Use above coil in an L/C circuit"
  121. 1210  PRINT " (4) EXIT"
  122. 1220  Z$=INKEY$:IF Z$=""THEN 1220
  123. 1230  IF Z$="2"THEN UH=U:CLS:CHAIN"coildsgn"
  124. 1240  IF Z$="4"THEN CLS:GOTO 340
  125. 1250  E1=17:E2=23:E3=1:GOSUB 280
  126. 1260  IF Z$="3"THEN GOSUB 2820:F=0:W=0:X=0:C=0:GOTO 1310
  127. 1270  E1=5:E2=18:E3=1:GOSUB 280
  128. 1280  R=0:L=0:N=0:T=0:GOTO 710
  129. 1290  '
  130. 1300  '.....L/C circuit
  131. 1310  LOCATE 3,54:PRINT "L/C NETWORK"
  132. 1320  PRINT UL$;
  133. 1330  LOCATE CSRLIN-3,40:PRINT "OPEN"
  134. 1340  LOCATE CSRLIN,40:PRINT "OPEN"
  135. 1350  LOCATE CSRLIN,40:PRINT "LOCATE"
  136. 1360  '.....inputs
  137. 1370  GOSUB 1490:IF F+W THEN 1410
  138. 1380  INPUT "ENTER: Frequency (MHz) .........";F:IF F THEN W=300/F
  139. 1390  GOSUB 1490:IF W+F THEN 1410
  140. 1400  INPUT "ENTER: Wavelength (metres) .....";W:IF W THEN F=300/W
  141. 1410  GOSUB 1490:IF C THEN 1430
  142. 1420  INPUT "ENTER: Capacitance (pF).........";C
  143. 1430  GOSUB 1490:IF X THEN 1450
  144. 1440  INPUT "ENTER: Reactance (ohms) ........";X
  145. 1450  GOSUB 1490:IF U THEN 1470
  146. 1460  INPUT "ENTER: Inductance (>H)..........";U
  147. 1470  GOSUB 1490:GOTO 1370
  148. 1480  '
  149. 1490  JJ=1/(4*PI^2)*10^6    'JJ=25330.29
  150. 1500  IF U=0 AND C*F<>0 THEN U=JJ/F^2/C:GOTO 1490
  151. 1510  IF U=0 AND X*F<>0 THEN U=X/(2*PI*F):GOTO 1490
  152. 1520  IF C=0 AND F*U<>0 THEN C=JJ/F^2/U:GOTO 1490
  153. 1530  IF F=0 AND C*U<>0 THEN F=SQR(JJ/C/U):W=300/F:GOTO 1490
  154. 1540  IF F=0 AND X*U<>0 THEN F=X/(2*PI*U):W=300/F:GOTO 1490
  155. 1550  IF F=0 AND X*C<>0 THEN F=10^6/(2*PI*X*C):W=300/F:GOTO 1490
  156. 1560  IF X=0 AND F*C<>0 THEN X=10^6/(2*PI*F*C):GOTO 1490
  157. 1570  IF F*X*U*C THEN 1600 ELSE 1580
  158. 1580  E1=5:E2=5:E3=41:GOSUB 280:LOCATE 5,41:RETURN
  159. 1590  '
  160. 1600  LOCATE 5,41:PRINT X$
  161. 1610  LOCATE 5,42:PRINT "Frequency................";USING U$;F;:PRINT " MHz"
  162. 1620  LOCATE 6,42:PRINT "Wavelength...............";USING U$;W;:PRINT " m."
  163. 1630  LOCATE 7,42:PRINT "Reactance................";USING U$;X;:PRINT " -"
  164. 1640  LOCATE 8,42:PRINT "Inductance...............";USING U$;U;:PRINT " >H"
  165. 1650  LOCATE 9,42:PRINT "Capacitance..............";USING U$;C;:PRINT " pF"
  166. 1660  COLOR 0,7
  167. 1670  LOCATE 10,41:PRINT " React.& Freq. with variable capacitor:"
  168. 1680  COLOR 7,0
  169. 1690  FOR VAR=1 TO 4
  170. 1700  PF=C*0.2*VAR:FQC=SQR(25330/PF/U):XX=10^6/(2*PI*FQC*PF)
  171. 1710  LOCATE 15-VAR,41:PRINT USING U$;XX;:PRINT " -"
  172. 1720  LOCATE 15-VAR,53:PRINT USING U$;FQC;:PRINT " MHz @";
  173. 1730  PRINT USING U$;PF;:PRINT " pF"
  174. 1740  NEXT VAR
  175. 1750  UFREQ=U
  176. 1760  IF UFREQ<>UCOIL THEN E1=5:E2=14:E3=1:GOSUB 280  'erase coil data
  177. 1770  LOCATE 15,41:PRINT L$;
  178. 1780  IF X*T THEN GOSUB 2080
  179. 1790  GOSUB 2850
  180. 1800  '
  181. 1810  LOCATE 25,1:PRINT STRING$(80,32);
  182. 1820  E1=11:E2=18:E3=1:GOSUB 280
  183. 1830  COLOR 0,7
  184. 1840  LOCATE 16
  185. 1850  LOCATE ,41:PRINT " Press number in ( ) for next step:"
  186. 1860  COLOR 7,0
  187. 1870  LOCATE ,41:PRINT " (1) Re-do with same Frequency"
  188. 1880  LOCATE ,41:PRINT " (2) Re-do with same Reactance"
  189. 1890  LOCATE ,41:PRINT " (3) Re-do with same Capacitance"
  190. 1900  LOCATE ,41:PRINT " (4) Re-do with same Inductance"
  191. 1910  LOCATE ,41:PRINT " (5) Design a";INT(C);"pF Tuning Capacitor"
  192. 1920  UH=INT(U*1000+0.5)/1000
  193. 1930  LOCATE ,41:PRINT " (6) Design a";UH;">H coil"
  194. 1940  LOCATE ,41:PRINT " (7) Find a stock";UH;">H coil"
  195. 1950  LOCATE ,41:PRINT " (8) EXIT";
  196. 1960  Z$=INKEY$:IF VAL(Z$)>=1 AND VAL(Z$)<=8 THEN 1970 ELSE 1960
  197. 1970  E1=16:E2=24:E3=41:GOSUB 280
  198. 1980  IF Z$="1"THEN X=0:C=0:U=0:GOSUB 2820:GOTO 1360
  199. 1990  IF Z$="2"THEN F=0:W=0::C=0:U=0:GOSUB 2820:GOTO 1360
  200. 2000  IF Z$="3"THEN F=0:W=0:X=0:U=0:GOSUB 2820:GOTO 1360
  201. 2010  IF Z$="4"THEN F=O:W=0:X=0:C=0:GOSUB 2820:GOTO 1360
  202. 2020  IF Z$="5"THEN CLS:CHAIN"capytel"
  203. 2030  IF Z$="6"THEN 1270
  204. 2040  IF Z$="7"THEN U=UH:CLS:CHAIN"aircore"
  205. 2050  IF Z$="8"THEN CLS:GOTO 340
  206. 2060  END
  207. 2070  '
  208. 2080  '.....Q option
  209. 2090  IF UFREQ<>UCOIL THEN RETURN       'uH not same
  210. 2100  LOCATE 17,2
  211. 2110  COLOR 0,7
  212. 2120  PRINT " Do you want to estimate the Q of this circuit ?  (y/n) "
  213. 2130  COLOR 7,0
  214. 2140  Z$=INKEY$
  215. 2150  IF Z$="y"OR Z$="Y"THEN 2190
  216. 2160  IF Z$="n"OR Z$="N"THEN LOCATE CSRLIN-1:PRINT STRING$(80,32);:RETURN
  217. 2170  GOTO 2140
  218. 2180  '
  219. 2190  '.....calculate Q
  220. 2200  LOCATE CSRLIN-1:PRINT STRING$(80,32);:LOCATE CSRLIN-1
  221. 2210  IF UM=1 THEN 2270
  222. 2220  '
  223. 2230  INPUT " ENTER: Diameter of wire in coil (mm.).....";DIA:DIA=DIA/UM
  224. 2240  OPI=(10371/(DIA*10^3)^2)/12000   'ohms per inch
  225. 2250  GOTO 2330
  226. 2260  '
  227. 2270  INPUT " ENTER: Size of wire in coil........A.W.G.#";AWG
  228. 2280  FOR GA=1 TO 40
  229. 2290  IF GA=AWG THEN DIA=AWG(GA,1):OPI=AWG(GA,2):GOTO 2330
  230. 2300  NEXT GA
  231. 2310  GOTO 2270
  232. 2320  '
  233. 2330  IF DIA<=SP THEN 2400
  234. 2340  BEEP:COLOR 0,7
  235. 2350  PRINT " WIRE DIAMETER MUST BE LESS THAN TURN SPACING!...Press any key...."
  236. 2360  IF INKEY$=""THEN COLOR 7,0:GOTO 2360
  237. 2370  VIEW PRINT 18 TO 23:CLS:VIEW PRINT:LOCATE 18:GOTO 2210
  238. 2380  GOTO 2080
  239. 2390  '
  240. 2400  VIEW PRINT 17 TO 23:CLS:VIEW PRINT:LOCATE 17
  241. 2410  LGTH=PI*D*N        'length of wire in coil in inches
  242. 2420  RES=LGTH*OPI       'resistance of coil
  243. 2430  Q=X/RES            'Q of series resonant circuit
  244. 2440  LOCATE CSRLIN-1:PRINT STRING$(80,32);
  245. 2450  LOCATE 11:PRINT STRING$(40,32):LOCATE CSRLIN-1
  246. 2460  IF AWG=0 THEN PRINT :GOTO 2480
  247. 2470  PRINT " Wire size...............#";USING U2$;AWG;:PRINT " AWG"
  248. 2480  PRINT " Wire diameter (";UM$;")......";USING U1$;DIA*UM
  249. 2490  PRINT " Wire length (";UM$;")........";USING U1$;LGTH*UM
  250. 2500  PRINT " Wire resistance (ohms)...";USING U1$;RES
  251. 2510  PRINT " Q of unloaded circuit....";USING U1$;Q
  252. 2520  QU=Q
  253. 2530  'PRINT L$
  254. 2540  LOCATE 17,2:COLOR 0,7
  255. 2550  INPUT " ENTER: Parallel load resistance (ohms)";RES
  256. 2560  COLOR 7,0
  257. 2570  LOCATE CSRLIN-1:PRINT STRING$(80,32);
  258. 2580  Q=RES/X:
  259. 2590  LOCATE CSRLIN-2:PRINT STRING$(40,32):LOCATE CSRLIN-1
  260. 2600  PRINT " Load resistance (ohms)...";USING U1$;RES
  261. 2610  PRINT " Q of loaded circuit......";USING U1$;Q
  262. 2620  QD=Q
  263. 2630  IL=20*LOG(1/(1-QD/QU))*0.43429
  264. 2640  PRINT " Insertion loss (dB.......";USING U1$;IL
  265. 2650  'PRINT L$
  266. 2660  RETURN
  267. 2670  '
  268. 2680  '.....diagram
  269. 2690  COLOR 0,7
  270. 2700  J=22
  271. 2710  LOCATE 3,J:PRINT "                                      "
  272. 2720  LOCATE 4,J:PRINT "                            L         "
  273. 2730  LOCATE 5,J:PRINT "     L     C            VARPTRSOUNDSOUNDORORORORSOUNDSOUNDCOLOR    "
  274. 2740  LOCATE 6,J:PRINT " SOUNDSOUNDSOUNDORORORORSOUNDSOUNDSOUND<0xB4!>BLOADSOUNDSOUNDSOUND     SOUNDSOUNDSOUND<0xB4!>        BLOADSOUNDSOUNDSOUND "
  275. 2750  LOCATE 7,J:PRINT "                        CLSSOUNDSOUNDSOUND<0xB4!>BLOADSOUNDSOUNDSOUND'    "
  276. 2760  LOCATE 8,J:PRINT "                            C         "
  277. 2770  LOCATE 9,J:PRINT "      SERIES      or      PARALLEL    "
  278. 2780  COLOR 7,0
  279. 2790  PRINT UL$;
  280. 2800  RETURN
  281. 2810  '
  282. 2820  E1=5:E2=16:E3=41:GOSUB 280
  283. 2830  RETURN
  284. 2840  '
  285. 2850  'HARDCOPY
  286. 2860  GOSUB 2970:LOCATE 25,2:COLOR 14,6
  287. 2870  PRINT " Press 1 to print screen, 2 to print screen & ";
  288. 2880  PRINT "advance paper, or 3 to continue.";:COLOR 7,0
  289. 2890  Z$=INKEY$:IF Z$="3"THEN GOSUB 2970:RETURN
  290. 2900  IF Z$="1"OR Z$="2"THEN GOSUB 2970:GOTO 2920
  291. 2910  GOTO 2890
  292. 2920  FOR QX=1 TO 24:FOR QY=1 TO 80
  293. 2930  LPRINT CHR$(SCREEN(QX,QY));
  294. 2940  NEXT QY:NEXT QX
  295. 2950  IF Z$="2"THEN LPRINT CHR$(12)
  296. 2960  GOTO 2860
  297. 2970  LOCATE 25,1:PRINT STRING$(80,32);:RETURN
  298.